home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / vbdRect.cls < prev    next >
Text File  |  1999-06-17  |  7KB  |  216 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "vbdRectangle"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' VbDraw Rectangle object.
  16.  
  17. Implements vbdObject
  18.  
  19. ' The surface on which the user is clicking
  20. ' to define the object. This is set only during
  21. ' creation of this object.
  22. Public WithEvents m_Canvas As PictureBox
  23. Attribute m_Canvas.VB_VarHelpID = -1
  24. Private m_DrawingStarted As Boolean
  25.  
  26. ' Constituent vbdPolygon object.
  27. Private m_Polygon As vbdPolygon
  28. Private m_Object As vbdObject
  29.  
  30. ' Rubberband variables.
  31. Private m_StartX As Single
  32. Private m_StartY As Single
  33. Private m_LastX As Single
  34. Private m_LastY As Single
  35. ' Start drawing a rubberband box.
  36. Private Sub m_Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  37.     m_DrawingStarted = True
  38.  
  39.     ' Start using dotted vbInvert mode.
  40.     m_Canvas.DrawMode = vbInvert
  41.     m_Canvas.DrawStyle = vbDot
  42.  
  43.     ' Start the first rubberband box.
  44.     m_StartX = X
  45.     m_StartY = Y
  46.     m_LastX = X
  47.     m_LastY = Y
  48.     m_Canvas.Line (m_StartX, m_StartY)-(m_LastX, m_LastY), , B
  49. End Sub
  50.  
  51. ' Continue drawing the rubberband box.
  52. Private Sub m_Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  53.     If Not m_DrawingStarted Then Exit Sub
  54.  
  55.     ' Erase the old box.
  56.     m_Canvas.Line (m_StartX, m_StartY)-(m_LastX, m_LastY), , B
  57.  
  58.     ' Update the point.
  59.     m_LastX = X
  60.     m_LastY = Y
  61.  
  62.     ' Draw the new box.
  63.     m_Canvas.Line (m_StartX, m_StartY)-(m_LastX, m_LastY), , B
  64. End Sub
  65.  
  66.  
  67. ' Finish drawing the rubberband box.
  68. Private Sub m_Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  69.     If Not m_DrawingStarted Then Exit Sub
  70.  
  71.     ' Erase the old box.
  72.     m_Canvas.Line (m_StartX, m_StartY)-(m_LastX, m_LastY), , B
  73.  
  74.     ' Go back to vbCopyPen drawing mode.
  75.     m_Canvas.DrawMode = vbCopyPen
  76.  
  77.     ' Stop receiving events from the canvas.
  78.     Set m_Canvas = Nothing
  79.  
  80.     ' Create the vbdPolygon that represents us.
  81.     Set m_Polygon = New vbdPolygon
  82.     Set m_Object = m_Polygon
  83.     With m_Polygon
  84.         .NumPoints = 4
  85.         .X(1) = m_StartX
  86.         .X(2) = m_LastX
  87.         .X(3) = m_LastX
  88.         .X(4) = m_StartX
  89.         .Y(1) = m_StartY
  90.         .Y(2) = m_StartY
  91.         .Y(3) = m_LastY
  92.         .Y(4) = m_LastY
  93.         .Closed = True
  94.     End With
  95.  
  96.     ' Tell the form to save us.
  97.     frmVbDraw.AddObject Me
  98.  
  99.     ' Select the arrow tool.
  100.     frmVbDraw.tbrTools.Buttons("Arrow").Value = tbrPressed
  101. End Sub
  102. Private Property Set vbdObject_Canvas(ByVal RHS As PictureBox)
  103.     Set m_Canvas = RHS
  104. End Property
  105.  
  106. Private Property Get vbdObject_Canvas() As PictureBox
  107.     Set vbdObject_Canvas = m_Canvas
  108. End Property
  109.  
  110. ' Draw the object in a metafile.
  111. Private Sub vbdObject_DrawInMetafile(ByVal mf_dc As Long)
  112.     m_Object.DrawInMetafile mf_dc
  113. End Sub
  114. ' Return the object's DrawWidth.
  115. Public Property Get vbdObject_DrawWidth() As Integer
  116.     vbdObject_DrawWidth = m_Object.DrawWidth
  117. End Property
  118. ' Set the object's DrawWidth.
  119. Public Property Let vbdObject_DrawWidth(ByVal new_value As Integer)
  120.     m_Object.DrawWidth = new_value
  121. End Property
  122.  
  123. ' Return the object's DrawStyle.
  124. Public Property Get vbdObject_DrawStyle() As DrawStyleConstants
  125.     vbdObject_DrawStyle = m_Object.DrawStyle
  126. End Property
  127. ' Set the object's DrawStyle.
  128. Public Property Let vbdObject_DrawStyle(ByVal new_value As DrawStyleConstants)
  129.     m_Object.DrawStyle = new_value
  130. End Property
  131.  
  132. ' Return the object's ForeColor.
  133. Public Property Get vbdObject_ForeColor() As OLE_COLOR
  134.     vbdObject_ForeColor = m_Object.ForeColor
  135. End Property
  136. ' Set the object's ForeColor.
  137. Public Property Let vbdObject_ForeColor(ByVal new_value As OLE_COLOR)
  138.     m_Object.ForeColor = new_value
  139. End Property
  140.  
  141. ' Return the object's FillColor.
  142. Public Property Get vbdObject_FillColor() As OLE_COLOR
  143.     vbdObject_FillColor = m_Object.FillColor
  144. End Property
  145. ' Set the object's FillColor.
  146. Public Property Let vbdObject_FillColor(ByVal new_value As OLE_COLOR)
  147.     m_Object.FillColor = new_value
  148. End Property
  149.  
  150. ' Return the object's FillStyle.
  151. Public Property Get vbdObject_FillStyle() As FillStyleConstants
  152.     vbdObject_FillStyle = m_Object.FillStyle
  153. End Property
  154. ' Set the object's FillStyle.
  155. Public Property Let vbdObject_FillStyle(ByVal new_value As FillStyleConstants)
  156.     m_Object.FillStyle = new_value
  157. End Property
  158.  
  159. ' Return this object's bounds.
  160. Public Sub vbdObject_Bound(ByRef xmin As Single, ByRef xmax As Single, ByRef ymin As Single, ByRef ymax As Single)
  161.     m_Object.Bound xmin, ymin, xmax, ymax
  162. End Sub
  163. ' Draw the object on the canvas.
  164. Public Sub vbdObject_Draw(ByVal pic As Object)
  165.     m_Object.Draw pic
  166. End Sub
  167. ' Initialize the object using a serialization string.
  168. ' The serialization does not include the
  169. ' ObjectType(...) part.
  170. Private Property Let vbdObject_Serialization(ByVal RHS As String)
  171. 'Dim token_name As String
  172. 'Dim token_value As String
  173. 'Dim next_x As Integer
  174. 'Dim next_y As Integer
  175. '
  176. '    InitializeDrawingProperties Me
  177. '
  178. '    ' Read tokens until there are no more.
  179. '    Do While Len(RHS) > 0
  180. '        ' Read a token.
  181. '        GetNamedToken RHS, token_name, token_value
  182. '        Select Case token_name
  183. '            Case "NumPoints"
  184. '                ' This allocates the m_X and m_Y arrays.
  185. '                m_NumPoints = CSng(token_value)
  186. '                next_x = 1
  187. '                next_y = 1
  188. '            Case "X"
  189. '                x(next_x) = CSng(token_value)
  190. '                next_x = next_x + 1
  191. '            Case "Y"
  192. '                y(next_y) = CSng(token_value)
  193. '                next_y = next_y + 1
  194. '            Case Else
  195. '                ReadDrawingPropertySerialization Me, token_name, token_value
  196. '        End Select
  197. '    Loop
  198. End Property
  199. ' Return a serialization string for the object.
  200. Public Property Get vbdObject_Serialization() As String
  201. 'Dim txt As String
  202. 'Dim i As Integer
  203. '
  204. '    txt = DrawingPropertySerialization(Me)
  205. '    txt = txt & " NumPoints(" & Format$(NumPoints) & ")"
  206. '    For i = 1 To NumPoints
  207. '        With m_OriginalPoints(i)
  208. '            txt = txt & vbCrLf & "    X(" & Format$(.x) & ")"
  209. '            txt = txt & " Y(" & Format$(.y) & ")"
  210. '        End With
  211. '    Next i
  212. '
  213. '    vbdObject_Serialization = "TwoDPolygon(" & txt & ")"
  214. End Property
  215.  
  216.